{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}
{- |
Module      :  Quadrature
Copyright   :  (c) Sergey Sichevskiy 2012
License     :  BSD3

Maintainer  :  s.sichevskij@gmal.com
Stability   :  experimental
Portability :  portable



-}
 
module Quadrature
 ( Quadrature (..)
 ) where

{--
import Data.List
import Control.Concurrent
import Control.Parallel
import Control.Parallel.Strategies
import Control.Exception (evaluate)
import Control.Monad
import Control.Applicative( (<$>) )
import System.IO.Unsafe
--}

import Data.BFunction ( (:~>:)(..) )

class Quadrature b a where -- | b -> a where
  quad :: (a,a) -> a -> b -> a

-- Интегрирование функции методом трапеций.
instance (a ~ Double, Enum a) => Quadrature (a -> a) a where
  quad (a,b) d f = d * (c + e)
    where
      c = 0.5 * (f a + f b)
      e = sum [ f x |  x <- [a+d, a+2*d .. b-d]]
{--
      e = parSumEval 8 [ f x |  x <- [a+d, a+2*d .. b-d]]
      e = sum $ parMap rpar f [a+d, a+2*d .. b-d]
      e = sum $ parEval [ f x |  x <- [a+d, a+2*d .. b-d]]
--}


-- Интегрирование функции методом трапеций.
instance (a ~ Double, Enum a) => Quadrature (a :~>: a) a where
   quad (l,r) _ (C v) = v * (r-l)

   quad (l,r) h (F (l',r') f) | r<l' || r'<l = 0
                              | otherwise    = quad (a,b) h f
                              where 
                                a = max l l'
                                b = min r r'

{--
parEval :: [Double] -> [Double]
parEval [] = []
parEval (x:xs) = x `par` es `pseq` (x : es)
  where
    es = parEval xs

parSumEval i xs = unsafePerformIO $ do

  out <- replicateM (length ys) newEmptyMVar

  zipWithM_ (parEvalIO)  out ys

  sum <$> mapM takeMVar out

  where
    n = ceiling $ (fromIntegral $ length xs) /i

    ys = f n xs

    f _ [] = []
    f n xs = (take n xs) : f n (drop n xs)

parEvalIO mv xs = forkIO $ do

     s <- evaluate $ foldl' (+) 0 xs
     
     putStrLn $ "sum : " ++ show s

     putMVar mv s
--}